home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / dev / gui / DesignerV1_53.lha / Designer / ShowIconDemo / ShowIconDemo.pas < prev    next >
Pascal/Delphi Source File  |  1995-04-28  |  3KB  |  126 lines
  1. program showicondemo;
  2.  
  3. Uses exec,intuition,gadtools,graphics,amiga,diskfont,
  4.      workbench,utility,showicondemowin,dos;
  5.  
  6. Const
  7.   Spaces : string = '                                        ';
  8.  
  9. Var
  10.  done     : boolean;
  11.  class    : long;
  12.  code     : word;
  13.  pgsel    : pGadget;
  14.  imsg     : pintuimessage;
  15.  dummy    : long;
  16.  awport   : pmsgport;
  17.  id       : long;
  18.  msg      : pappmessage;
  19.  argptr   : pwbarg;
  20.  dirname  : string;
  21.  filename : string;
  22.  argtype  : long;
  23.  
  24. Procedure ProcessWindowWin0( Class : long ; Code : word ; IAddress : pbyte);
  25. Var
  26.   pgsel : pgadget;
  27. Begin
  28.   Case Class of
  29.     IDCMP_GADGETUP :
  30.       Begin
  31.         { Gadget message, gadget = pgsel. }
  32.         pgsel:=pgadget(iaddress);
  33.       end;
  34.     IDCMP_CLOSEWINDOW :
  35.       Begin
  36.         done:=true;
  37.         { CloseWindow Now }
  38.       end;
  39.     IDCMP_REFRESHWINDOW :
  40.       Begin
  41.         GT_BeginRefresh( Win0);
  42.         { Refresh window. }
  43.         GT_EndRefresh( Win0, True);
  44.       end;
  45.    end;
  46. end;
  47.  
  48. Begin
  49.   id:=1;
  50.   done:=false;
  51.   if OpenLibs then
  52.     Begin
  53.       awport:=createmsgport;
  54.       if awport<>nil then
  55.         begin
  56.             if OpenWindowWin0(awport,id) then
  57.             begin
  58.                 while (not done) do
  59.                 begin
  60.                   dummy:=Wait(bitmask(Win0^.UserPort^.mp_SigBit) or
  61.                               bitmask(awport^.mp_sigbit));
  62.                 
  63.                   { Check Window Message Port }
  64.                   
  65.                   imsg:=GT_GetIMsg(Win0^.UserPort);
  66.                   while (imsg <>nil ) do
  67.                     begin
  68.                       class:=imsg^.Class;
  69.                       code:=imsg^.Code;
  70.                       pgsel:=pgadget(imsg^.IAddress); { Only reference if it is a gadget message }
  71.                       GT_ReplyIMsg(imsg);
  72.                       ProcessWindowWin0(class, code, pbyte(pgsel));
  73.                       imsg:=GT_GetIMsg(Win0^.UserPort);
  74.                     end;
  75.                   
  76.                   { Check AppWindow Port }
  77.                   
  78.                   msg:=pappmessage(GetMsg(awport));
  79.                   while (msg <>nil ) do
  80.                     begin
  81.                       
  82.                       { This only handles the first icon in list }
  83.                       { argptr is actually an array of pwbarg }
  84.                       
  85.                       argptr:=msg^.am_arglist;
  86.                         
  87.                       { Get directory lock }
  88.                         
  89.                       dirname:=fexpandlock(argptr^.wa_lock);
  90.                       
  91.                       { Get filename }
  92.                       
  93.                       ctopas(argptr^.wa_name^,filename);
  94.                       
  95.                       ReplyMsg(pmessage(msg));
  96.                       
  97.                       writeln('Dir = '+dirname+copy(spaces,1,40-length(dirname))+'  Name = '+filename);
  98.                       
  99.                       msg:=pappmessage(GetMsg(awport));
  100.                     end;
  101.                   
  102.                 end;
  103.               CloseWindowWin0;
  104.             end
  105.            else
  106.             writeln('Cannot open window.');
  107.           
  108.           { Make sure message port empty before freeing }
  109.           
  110.           msg:=pappmessage(GetMsg(awport));
  111.           while (msg <>nil ) do
  112.             begin
  113.               ReplyMsg(pmessage(msg));
  114.               msg:=pappmessage(GetMsg(awport));
  115.             end;
  116.           
  117.           DeleteMsgPort(awport);
  118.         end
  119.        else
  120.         writeln('Cannot create message port.');
  121.       CloseLibs;
  122.     end
  123.    else
  124.     writeln('Cannot open libraries.');
  125. end.
  126.